(ns gamingmain)

(def leagues ["Platinum" "Gold" "Silver" "Bronze"])

(def contestants {"haxxor" ["Gold" "Silver"] 
                  "cliffyb" ["Platinum" "Gold"] 
                  "lovemachine991" ["Silver" "Bronze"] 
                  "TheDilejni" ["Gold" "Silver"] 
                  "igyman" ["Platinum" "Gold"]
                  "taker" ["Silver" "Bronze"]
                  "darkfukker" ["Gold" "Silver"]
                  "mrnice" ["Silver" "Bronze"]
                  "darkhelmet" ["Platinum" "Gold"]
                  "fakesign" ["Gold" "Silver"]
                  "Anakin992" ["Silver" "Bronze"]
                  "halomaster455" ["Platinum" "Gold"]
                  "1Nightmare1uhq" ["Gold" "Silver"]
                  "Duck64x" ["Silver" "Bronze"]
                  "hero3120" ["Platinum" "Gold"]
                  "bucknorris" ["Gold" "Silver"]})

(defn domain 
  "defines the contestant number for each league" 
  [length-vec limit]
  (let [counter (- (* length-vec limit) 1)]
    (loop [result [] x counter]
      (if (< x 0) 
        result
        (recur (conj result (conj [] 0 x)) (dec x))))))

;(domain (count leagues) 4)

(defn nth-map
  "returns the nth element of a map"
  [coll elem-index]
  (let [coll-keys (keys coll)]
    (get coll (nth coll-keys elem-index))))

(defn vec-remove 
  "removes an element from a vector" 
  [coll indx]
  (let [counter 0 
        svec-after (subvec coll (+ indx 1))]
    (reduce (fn [result svafter] 
              (conj result svafter)) 
            (subvec coll 0  indx) 
            svec-after)))

(defn createslots
  "creates the slots for each league"
  [lgs sllimit]
  (let [slindx (range 0 (count lgs))]
  (reduce (fn [res lges] 
           (let [elslots (repeat sllimit lges)]
             (reduce (fn [rs slts] 
                       (conj rs slts))
                     res elslots)))
          [] slindx)))

(defmulti getcost (fn [lg ct cst] 
                    (cond
                      (= lg (first ct)) :cond1
                      (= lg (second ct)):cond2)))

(defmethod getcost :cond1 [lg ct cst]
  (+ cst 0))

(defmethod getcost :cond2 [lg ct cst]
  (+ cst 1))

(defmethod getcost :default [lg ct cst]
  (+ cst 3))

(defn cost 
  "calculates the cost of assigning contestants to leagues" 
  [possol lgs conts limit] 
  (let [cost 0 
        slots (createslots lgs limit)]
    (loop [c cost 
           sl slots 
           counter 0]
      (if (= counter (count possol)) 
        c
        (let [leagueslot (nth possol counter)
              league (nth lgs (nth sl leagueslot)) 
              cont (nth-map conts counter)]
            (recur (getcost league cont c) (vec-remove sl (nth possol counter)) (inc counter)))))))

(defn printsolution 
  "prints the best solution of a problem" 
  [possol coll lgs limit] 
  (let [slots (createslots lgs limit) 
        conts (keys coll)]
    (loop [result [] 
           sl slots 
           counter 0]
      (if (= counter (count possol)) 
        result
        (let [leagueslot (nth possol counter)
              league (nth lgs (nth sl leagueslot)) 
              cont (nth conts counter)]
            (recur (conj result [cont league]) (vec-remove sl (nth possol counter)) 
            (inc counter)))))))

;mutator

;auxilliary function for the mutate function

(defn vec-mutate 
  "replaces an element from a vector" 
  [coll indx updated-el]
  (let [counter 0 
        svec-after (subvec coll (+ indx 1))]
    (reduce (fn [result svec]
        (conj result svec)) 
            (conj (subvec coll 0  indx) updated-el) svec-after)))

(defn mutate 
  "mutates the solution by increasing or decreasing one element by the entered amount" 
  [solution step lgs domn] 
  (let [i (quot (rand (count (domn (count lgs) 4))) 1) 
        dom (domn (count lgs) 4)]
     (cond
       (and (< (nth solution i) (first (nth dom i))) (> (nth solution i) (second (nth dom i)))) 
       (if (< (rand) 0.5) 
         (vec-mutate solution i (- (nth solution i) step))
         (vec-mutate solution i (+ (nth solution i) step))) 
       (> (nth solution i) (first (nth dom i))) (vec-mutate solution i (- (nth solution i) step))
       (<= (nth solution i) (second (nth dom i))) (vec-mutate solution i (+ (nth solution i) step)))))

;crossover

;auxilliary function for the crossover function

(defn vec-crossover 
  "creates a new vector from parts of the two entered vectors divided at the entered index" 
  [coll1 coll2 indx]
  (let [counter 0 
        svec-after (subvec coll2 (+ indx 1))]
    (reduce (fn [result svaft]
              (conj result svaft)) 
            (subvec coll1 0  (+ indx 1)) svec-after)))

(defn crossover 
  "creates a new solution from two old solutions" 
  [sol1 sol2 dom lgs]
  (let [i (+ (quot (rand (- (count (dom (count lgs) 4)) 3)) 1) 1)]
    (vec-crossover sol1 sol2 i)))


;genetic algorithm

;auxilliary functions of the genalg function

(defn make-chromosome 
  "randomly creates one possible solution" 
  [dom]
    (reduce (fn [result d]
        (conj result (quot (rand (second d)) 1))) 
            [] dom))

(defn rankgen 
  "ranks the population of chromosomes in ascending order by cost" 
  [population costf lgs conts limit]
  (let [scr (reduce (fn [scores popul]
                      (sort (conj scores [(costf popul lgs conts limit) popul]))) 
                    [] population)]    
    (reduce (fn [result sc] 
              (conj result (second sc))) 
            [] scr)))
  

;auxilliary function for the nextgen function
(defn mutator 
  "creates a mutated chromosome according to the rules of the genetic algorithm" 
  [rpop topelite mutprob step lgs domn]
  (if (< (rand) mutprob) 
    (let [c (quot (rand topelite) 1)]
      (mutate (nth rpop c) step lgs domn))
    (let [c1 (quot (rand topelite) 1) 
          c2 (quot (rand topelite) 1)]
      (crossover (nth rpop c1) (nth rpop c2) domn lgs))))
 
(defn nextgen 
  "creates the next generation of possible solutions according to the rules of the genetic algorithm" 
  [rpop topelite mprob step lgs domn]
  (subvec (reduce (fn [res rkedpop]
                    (conj res (mutator rpop topelite mprob step lgs domn)))
                  (subvec rpop 0 topelite) rpop) 0 (count rpop)))

;end auxilliary functions for genalg

;main function of the genetic algorithm

(defn genalg 
  "performs the genetic algorithm" 
  [dom popsize elite mutprob step maxiter lgs conts costf domf limit] 
  (let [population [] 
        counter 0 
        topelite (quot (* elite popsize) 1)
        psizecounter (range 0 popsize)
        firstgen (reduce (fn [popul popcnt]
              (conj popul (make-chromosome dom))) population psizecounter)
        itercnt (range 0 maxiter)
        result (reduce (fn [res itcnt] 
                         (nextgen (rankgen firstgen costf lgs conts limit) topelite mutprob step lgs domf)) 
                       [] itercnt)]
    (first result)))

;(genalg (domain (count leagues) 4) 10 0.2 0.2 1 10)
;to execute the program it is necessary to call the printsolution function as follows:
(printsolution (genalg (domain (count leagues) 4) 10 0.2 0.2 1 10 leagues contestants cost domain 4) contestants leagues 4)